home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / ZIPHEAD.BAS < prev   
BASIC Source File  |  1992-08-10  |  3KB  |  86 lines
  1. 'Date: 12-30-91 (20:04)
  2. 'From: HOWARD MENCHER
  3. 'Subj: READ ZIP HEADER
  4. '--------------------------------------------------------------------------
  5.         CLS
  6.         DEFINT A-Z
  7.         DIM filenames$(255)
  8.         foundnames = 0
  9.         DIM signature AS STRING * 4: DIM junk AS STRING * 1
  10.         DIM tmpname AS STRING * 1
  11.         headsig$ = "04034B50"
  12.  
  13.         TYPE ziphdr
  14.                 signatr AS STRING * 4 'should be const 0x04034b50
  15.                 version AS INTEGER
  16.                 bitflag AS INTEGER
  17.                 stortype AS INTEGER
  18.                 time AS INTEGER
  19.                 date AS INTEGER
  20.                 crc AS LONG
  21.                 ziplen AS LONG
  22.                 fullsize AS LONG
  23.                 fnamelen AS INTEGER
  24.                 extra AS INTEGER
  25.         END TYPE
  26.  
  27.         DIM ziphead AS ziphdr
  28.  
  29.         INPUT "Name of .ZIP file to display (<CR> to end):", zname$
  30.         IF zname$ = "" THEN END
  31.  
  32. getzipdir:      '
  33.                 ' open in serial mode, read in 4 char at a time & look
  34.                 ' for signatures
  35.  
  36.                 OPEN "B", 1, zname$
  37.                 WHILE NOT EOF(1)
  38.                         sigpos& = SEEK(1)
  39.                         GET #1, , signature$
  40.                         b1 = ASC(LEFT$(signature$, 1))
  41.                         b2 = ASC(MID$(signature$, 2, 1))
  42.                         b3 = ASC(MID$(signature$, 3, 1))
  43.                         b4 = ASC(RIGHT$(signature$, 1))
  44.  
  45.                         tst4$ = HEX$(b4)
  46.                         IF LEN(tst4$) < 2 THEN tst4$ = "0" + tst4$
  47.  
  48.                         tst3$ = HEX$(b3)
  49.                         IF LEN(tst3$) < 2 THEN tst3$ = "0" + tst3$
  50.  
  51.                         tst2$ = HEX$(b2)
  52.                         IF LEN(tst2$) < 2 THEN tst2$ = "0" + tst2$
  53.  
  54.                         tst1$ = HEX$(b1)
  55.                         IF LEN(tst1$) < 2 THEN tst1$ = "0" + tst1$
  56.  
  57.                         result$ = tst4$ + tst3$ + tst2$ + tst1$
  58.  
  59.                         IF result$ = headsig$ THEN GOSUB readhdr
  60.                 WEND
  61.  
  62.         CLOSE : foundnames = foundnames - 1
  63.         FOR t = 0 TO foundnames
  64.         PRINT filenames$(t)
  65.         NEXT t
  66.         END
  67.  
  68.  
  69. readhdr:        ' try to make sense of the zip header
  70.                 SEEK #1, sigpos&
  71.                 GET #1, sigpos&, ziphead
  72.                 x = ziphead.fnamelen
  73.                 FOR t = 1 TO x
  74.                 GET #1, , tmpname$
  75.                 filenames$(foundnames) = filenames$(foundnames) + tmpname$
  76.                 NEXT t
  77.                 foundnames = foundnames + 1
  78.  
  79.                 x = ziphead.extra
  80.                 FOR t = 1 TO x
  81.                 GET #1, , junk$
  82.                 NEXT t
  83.                 totloffset& = sigpos& + 30 + ziphead.fnamelen + ziphead.extra +
  84.                 SEEK #1, totloffset&
  85. RETURN
  86.